home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / microcrn / issue_40.arc / SCANNER.ARC / SCRNSTUF.MOD < prev    next >
Encoding:
Modula Implementation  |  1988-01-11  |  9.7 KB  |  329 lines
  1. (* Code from Pascal column in Micro Cornucopia Issue #39 *)
  2.  
  3. IMPLEMENTATION MODULE ScrnStuff;
  4.  
  5. FROM SYSTEM IMPORT BYTE, ADDRESS, GETREG, SETREG, AX, BX, CX, DX,
  6.                    SWI, ADR, CODE, OUTBYTE, DOSCALL;
  7. FROM Config IMPORT Xsize, Ysize, Interleave, Unused, ScrSegment;
  8.  
  9. (* The EXPORT list has changed since the previous version *)
  10. (* Depending on the compiler, you may need this EXPORT *)
  11. (*EXPORT QUALIFIED Raster, Screen, ArrayLen, Lines, ClrScr, GrabClock, RlsClock,
  12.                  FastClock, SlowClock, Scan, GraphMode, PixAddress, SetBit,
  13.                  ClrBit, InvertBit, TextMode, Buffer, SetClock;  *)
  14.  
  15. CONST
  16.    PUSHBP = 55H;     (* machine code for push BP *)
  17.    POPBP = 5DH;      (* likewise for pop BP *)
  18. VAR
  19.    GReg6845 : ARRAY [0..15] OF BYTE;
  20.    TReg6845 : ARRAY [0..15] OF BYTE;
  21.    Scanning : POINTER TO BOOLEAN;
  22.    A : ADDRESS;
  23.  
  24. PROCEDURE ClrScr (VAR S:Screen);
  25. (* Clear the graphics screen by filling its memory with zeroes *)
  26. (* Not horribly fast, but adequate *)
  27. VAR
  28.    I, J : CARDINAL;
  29. BEGIN
  30.    FOR J := 0 TO ArrayLen DO
  31.       S[0,J] := CHR(0);
  32.       END;
  33.    FOR J := 1 TO Interleave-1 DO
  34.       S[J] := S[0];
  35.       END;
  36. END ClrScr;
  37.  
  38.  
  39. PROCEDURE GrabClock (IntNum : CARDINAL; TickLen : CARDINAL; VAR OldTick : CARDINAL)
  40.                      :ADDRESS;
  41. (* On further reflection it appears that this procedure is not needed *)
  42. (* Its function is performed when the external resident routine is installed *)
  43. BEGIN
  44. END GrabClock;
  45.  
  46.  
  47.  
  48. PROCEDURE RlsClock (OldVector : ADDRESS; IntNum : CARDINAL; OldTick : CARDINAL);
  49. (* The functions of this procedure are implemented in SlowClock *)
  50. BEGIN
  51. END RlsClock;
  52.  
  53.  
  54. PROCEDURE FastClock;
  55. (* The functions of this procedure are performed automatically by Scan *)
  56. BEGIN
  57. END FastClock;
  58.  
  59. PROCEDURE SetClock(t:CARDINAL);
  60. (* Set a new divisor for the clock hardware.  The normal divisor is 65536
  61.    (0), which gives a 55mS clock tick.  Do NOT call this routine with a
  62.    parameter of zero or the real time clock interrupt processing will be
  63.    halted.  Use SlowClock below to restore the clock to its normal function.
  64.    It is also unrealistic to expect everything to get done if the divisor
  65.    is set to a value much smaller than about 512 but feel free to 
  66.    experiment *)
  67. BEGIN
  68.    SETREG(CX,t);     (* new time constant for timer chip *)
  69.    SETREG(AX,3);     (* external resident function 3 *)
  70.    CODE(PUSHBP);
  71.    SWI(60H);
  72.    CODE(POPBP);
  73. END SetClock;
  74.  
  75. PROCEDURE SlowClock;
  76. (* Restore the clock hardware and interrupt vector to their original state *)
  77. (* Do not execute this procedure until you are finished with all scans. *)
  78. (* If you plan to scan more than one image, execute this procedure only *)
  79. (* after the last one has been scanned.  The called routine restores the *)
  80. (* clock to normal operation but does NOT de-install the resident code. *)
  81. BEGIN
  82.    SETREG(AX,1); (* Function code for resident routine *)
  83.    CODE(PUSHBP); 
  84.    SWI(60H);     (* accessed through a software interrupt *)
  85.    CODE(POPBP);
  86. END SlowClock;
  87.  
  88. PROCEDURE StartPrinter;
  89. CONST
  90. (* Change these constants and add or delete DOSCALLs to match your printer *)
  91.    ESC = 33C;
  92.    L = 'L';
  93. VAR
  94.    I, J : CARDINAL;
  95. BEGIN
  96.    DOSCALL(5H,ESC);    (* output graphics prefix *)
  97.    DOSCALL(5H, L);
  98.    DOSCALL(5H, Xsize MOD 256); (* Low order byte of Xsize *)
  99.    DOSCALL(5H, Xsize DIV 256); (* high order of Xsize *)
  100.    FOR I := 1 TO Xsize DO
  101.       DOSCALL(5H,0);
  102.       END;
  103.  
  104. (* With my printer, the print head does not return to home position after
  105.    a line of print until until you start sending the next line of data.
  106.    This delay allows the print head to return to home, then begin it's
  107.    movement before data capture is begun.  You will have to experiment
  108.    to determine the proper loop values for your hardware.  You may want
  109.    to make these values variables, entered from the keyboard *)
  110.    FOR J := 0 TO 1 DO
  111.       FOR I := 0 TO 23000 DO END;  (* Short Delay to allow printhead to start *)
  112.       END;
  113. END StartPrinter;
  114.  
  115. PROCEDURE StepPrinter;
  116. CONST
  117. (* Change these constants and add or delete DOSCALLs to match your printer *)
  118. (* For the Star Micronics printer, this performs a 2/144" line feed *)
  119.    CR = 15C;
  120.    ESC = 33C;
  121.    J = 'J';
  122.    N = 2C;
  123.    SPACE = ' ';
  124. VAR
  125.    I : CARDINAL;
  126. BEGIN
  127.    DOSCALL(5H,SPACE);
  128.    DOSCALL(5H,CR);
  129.    DOSCALL(5H,ESC);
  130.    DOSCALL(5H,J);
  131.    DOSCALL(5H,N);
  132. END StepPrinter;    
  133.  
  134. PROCEDURE Scan (VAR R : Buffer);
  135. VAR
  136.    A : ADDRESS;
  137.    
  138. BEGIN
  139.    StartPrinter;
  140.    A := ADR(R); (* address of where Modula needs the data *)
  141.    SETREG(AX,2);
  142.    SETREG(BX,A.OFFSET);
  143.    SETREG(DX,A.SEGMENT);
  144.    SETREG(CX,Xsize);
  145.    CODE(PUSHBP);
  146.    SWI(60H);
  147.    CODE(POPBP);
  148.  
  149.    WHILE Scanning^ DO END;    (* This is a quick and dirty method.  More 
  150.                                  elegant would be to have the resident scan
  151.                                  software act as a M2 coroutine. *)
  152.    StepPrinter;
  153. END Scan;
  154.  
  155. (* I have tested GraphMode and TextMode on my video card in all three
  156.    modes, CGA, EGA and HGA.  (My card emulates all three)  I have NOT
  157.    tested the routines on the individual adapters *)
  158.  
  159. PROCEDURE GraphMode;
  160. (* For CGA and EGA, call BIOS procedures to set the high resolution  *)
  161. (* monochrome graphics mode.  For Hercules, directly re-program the  *)
  162. (* hardware.                                                         *)
  163. CONST
  164.    Idx6845 = 3b4h;   (* 6845 index register *)
  165.    Data6845 = 3b5h;  (* 6845 data register *)
  166.    VideoMode = 3b8h; (* mode control register *)
  167. VAR
  168.    I : CARDINAL;
  169. BEGIN
  170.    CASE Interleave OF
  171.       1 : (* EGA Mode *)
  172.          SETREG(AX,000FH);
  173.          SWI(10H);   |
  174.       2 : (* CGA Mode *)
  175.          SETREG(AX,0006H);
  176.          SWI(10H);   |
  177.       4 : (* HGA Mode *)
  178.          FOR I := 0 TO 15 DO
  179.             OUTBYTE(Idx6845,I);
  180.             OUTBYTE(Data6845,GReg6845[I]);
  181.             END;
  182.          OUTBYTE(VideoMode, 0eh);
  183.       ELSE;
  184.    END;
  185. END GraphMode;
  186.  
  187. PROCEDURE TextMode;
  188. (* Same comments as for GraphMode above *)
  189. CONST
  190.    Idx6845 = 3b4h;   (* 6854 index register *)
  191.    Data6845 = 3b5h;
  192.    VideoMode = 3b8h;
  193. VAR
  194.    I : CARDINAL;
  195. BEGIN
  196.    CASE Interleave OF
  197.       1 : (* EGA Mode *)
  198.          SETREG(AX,0002H);
  199.          SWI(10H);   |
  200.       2 : (* CGA Mode *)
  201.          SETREG(AX,0002H);
  202.          SWI(10H);   |
  203.       4 : (* HGA Mode *)
  204.          FOR I := 0 TO 15 DO
  205.             OUTBYTE(Idx6845,I);
  206.             OUTBYTE(Data6845,TReg6845[I]);
  207.             END;
  208.          OUTBYTE(VideoMode, 20h);
  209.          SETREG(AX,0002H);
  210.          SWI(10H);
  211.       ELSE;
  212.    END;
  213. END TextMode;
  214.  
  215. PROCEDURE PixAddress (X:Xpos; Y:Ypos; VAR B:BitPos ): ADDRESS;
  216. (* From x and y pixel positions, calculate the physical address of the *)
  217. (* proper byte to modify.  Also returns the bit position within the    *)
  218. (* byte of the pixel.                                                  *)
  219. CONST
  220.    Xbytes = Xsize DIV 8;
  221. VAR
  222.    A : ADDRESS;
  223. BEGIN
  224.    A.SEGMENT := ScrSegment;
  225.    IF Interleave = 1 THEN
  226.       A.OFFSET := (Y * Xbytes) + (X DIV 8);
  227.    ELSE
  228.       A.OFFSET := (ArrayLen +1) * (Y MOD Interleave)
  229.                  +(Xbytes * (Y DIV Interleave))
  230.                  +(X DIV 8);
  231.       END;
  232.    B := 7 - (X MOD 8);
  233.    RETURN A;
  234. END PixAddress;
  235.  
  236. PROCEDURE SetBit (SrcByte:CHAR; BitNum:BitPos): CHAR;
  237. VAR
  238.    Temp : CARDINAL;
  239. BEGIN
  240.    Temp := ORD(SrcByte)*256+1;
  241.    SETREG(AX,Temp);
  242.    SETREG(CX,BitNum);
  243.    CODE(08H, 0C9H);     (* OR CL,CL  *)
  244.    CODE(74H, 02H);      (* JZ NOROT  *)
  245.    CODE(0D2H,0C0H);     (* ROL AL,CL *)
  246.    CODE(8,0C4H);        (* NOROT: OR AH,AL *)
  247.    GETREG(AX,Temp);
  248.    RETURN CHR(Temp DIV 256);
  249. END SetBit;
  250.  
  251.  
  252. PROCEDURE ClrBit (SrcByte:CHAR; BitNum:BitPos): CHAR;
  253. VAR
  254.    Temp : CARDINAL;
  255. BEGIN
  256.    Temp := ORD(SrcByte)*256+0feh;
  257.    SETREG(AX,Temp);
  258.    SETREG(CX,BitNum);
  259.    CODE(08H, 0C9H);     (* OR CL,CL  *)
  260.    CODE(74H, 02H);      (* JZ NOROT  *)
  261.    CODE(0D2H,0C0H);     (* ROL AL,CL *)
  262.    CODE(20H,0C4H);      (* NOROT: AND AH,AL *)
  263.    GETREG(AX,Temp);
  264.    RETURN CHR(Temp DIV 256);
  265. END ClrBit;
  266.  
  267. PROCEDURE InvertBit (SrcByte:CHAR; BitNum:BitPos): CHAR;
  268. VAR
  269.    Temp : CARDINAL;
  270. BEGIN
  271.    Temp := ORD(SrcByte)*256+1;
  272.    SETREG(AX,Temp);
  273.    SETREG(CX,BitNum);
  274.    CODE(08H, 0C9H);     (* OR CL,CL  *)
  275.    CODE(74H, 02H);      (* JZ NOROT  *)
  276.    CODE(0D2H,0C0H);     (* ROL AL,CL *)
  277.    CODE(30h,0C4H);      (* NOROT: XOR AH,AL *)
  278.    GETREG(AX,Temp);
  279.    RETURN CHR(Temp DIV 256);
  280. END InvertBit;
  281.  
  282. BEGIN
  283. (* Initialize the values for 6845 graphics mode *)
  284.    GReg6845[0] := BYTE(37h);
  285.    GReg6845[1] := BYTE(2dh);
  286.    GReg6845[2] := BYTE(30h);
  287.    GReg6845[3] := BYTE(05h);
  288.    GReg6845[4] := BYTE(60h);
  289.    GReg6845[5] := BYTE(00h);
  290.    GReg6845[6] := BYTE(57h);
  291.    GReg6845[7] := BYTE(57h);
  292.    GReg6845[8] := BYTE(02h);
  293.    GReg6845[9] := BYTE(03h);
  294.    GReg6845[10] := BYTE(00h);
  295.    GReg6845[11] := BYTE(00h);
  296.    GReg6845[12] := BYTE(00h);
  297.    GReg6845[13] := BYTE(00h);
  298.    GReg6845[14] := BYTE(00h);
  299.    GReg6845[15] := BYTE(00h);
  300.  
  301. (* Initialize values for 6845 text mode *)
  302.    TReg6845[0] := BYTE(61h);
  303.    TReg6845[1] := BYTE(50h);
  304.    TReg6845[2] := BYTE(52h);
  305.    TReg6845[3] := BYTE(0fh);
  306.    TReg6845[4] := BYTE(19h);
  307.    TReg6845[5] := BYTE(06h);
  308.    TReg6845[6] := BYTE(19h);
  309.    TReg6845[7] := BYTE(19h);
  310.    TReg6845[8] := BYTE(02h);
  311.    TReg6845[9] := BYTE(0dh);
  312.    TReg6845[10] := BYTE(0bh);
  313.    TReg6845[11] := BYTE(0ch);
  314.    TReg6845[12] := BYTE(00h);
  315.    TReg6845[13] := BYTE(00h);
  316.    TReg6845[14] := BYTE(00h);
  317.    TReg6845[15] := BYTE(00h);
  318.  
  319. (* Get address of scanning flag from external routine *)
  320.    SETREG(AX,0);  (* report address function *)
  321.    CODE(PUSHBP);
  322.    SWI(60H);
  323.    CODE(POPBP);
  324.    GETREG(DX,A.SEGMENT);
  325.    GETREG(BX,A.OFFSET);
  326.    Scanning := A;
  327. END ScrnStuff.
  328.  
  329.